home *** CD-ROM | disk | FTP | other *** search
/ ShareWare OnLine 2 / ShareWare OnLine Volume 2 (CMS Software)(1993).iso / util2 / vol12n11.zip / QBDOS.BAS < prev    next >
BASIC Source File  |  1993-02-26  |  4KB  |  110 lines
  1. '********** QBDOS.BAS - reads file names from disk
  2.  
  3. 'Copyright (c) 1993 Ethan Winer
  4.  
  5. DEFINT A-Z
  6. DECLARE FUNCTION GetAttr% (FileName$)
  7. DECLARE FUNCTION SetAttr% (FileName$, Attribute)
  8. DECLARE FUNCTION QBDir$ (FileSpec$)
  9. DECLARE SUB Interrupt (IntNum, InRegs AS ANY, OutRegs AS ANY)
  10.  
  11. '---- Define the TYPE required by CALL INTERRUPT
  12. TYPE RegType
  13.   AX    AS INTEGER
  14.   BX    AS INTEGER
  15.   CX    AS INTEGER
  16.   DX    AS INTEGER
  17.   BP    AS INTEGER
  18.   SI    AS INTEGER
  19.   DI    AS INTEGER
  20.   Flags AS INTEGER
  21. END TYPE
  22.  
  23. DIM SHARED DTA AS STRING * 44           'this is DOS' work area
  24. DIM SHARED Regs AS RegType              'used by CALL Interrupt
  25. DIM SHARED LocalSpec AS STRING * 80     'using a fixed-length string
  26.                                         '  supports both QB and PDS
  27.  
  28. '======= Beginning of demonstration portion, remove the following code
  29. '        when adding this module to another program.
  30.  
  31. CLS
  32. Path$ = "C:\QB45\"                      'use "" for the current directory
  33. Spec$ = Path$ + "*.*"                   'find all matching files
  34.  
  35. DO
  36.   This$ = QBDir$(Spec$)                 'read the name of first one
  37.   IF This$ = "" THEN EXIT DO            'none found, all done
  38.   PRINT This$;                          'print the name
  39.  
  40.   Attr = GetAttr%(Path$ + This$)        'read its attributes
  41.   IF Attr% AND 1 THEN PRINT SPC(1); "Read-only";
  42.   IF Attr% AND 2 THEN PRINT SPC(1); "Hidden";
  43.   IF Attr% AND 4 THEN PRINT SPC(1); "System";
  44.   IF Attr% AND 32 THEN PRINT SPC(1); "Archive";
  45.  
  46.   PRINT                                 'kick out a new line
  47.   Spec$ = ""                            'clear Spec$ to find the rest
  48. LOOP
  49.  
  50. '======= END OF DEMO
  51.  
  52. FUNCTION GetAttr% (FileName$) STATIC
  53.  
  54.   LocalSpec$ = FileName$ + CHR$(0)      'add a CHR$(0) for DOS
  55.  
  56.   Regs.AX = &H4300                      'get attribute sevice
  57.   Regs.DX = VARPTR(LocalSpec$)          'show DOS where the local copy is
  58.   CALL Interrupt(&H21, Regs, Regs)      'read the attributes
  59.  
  60.   GetAttr% = Regs.CX AND &HFF           'assign the output
  61.   IF Regs.Flags AND 1 THEN              'oops, there was an error
  62.     GetAttr% = -1                       'return -1 as a flag
  63.   END IF
  64.  
  65. END FUNCTION
  66.  
  67. FUNCTION QBDir$ (Spec$) STATIC          'reports if a file exists
  68.  
  69.   LocalSpec$ = Spec$ + CHR$(0)          'add a CHR$(0) for DOS
  70.  
  71.   Regs.AX = &H1A00                      'assign DTA service
  72.   Regs.DX = VARPTR(DTA)                 'show DOS where to place it
  73.   CALL Interrupt(&H21, Regs, Regs)
  74.  
  75.   IF LEN(Spec$) THEN                    'find first matching file
  76.     Regs.AX = &H4E00
  77.   ELSE
  78.     Regs.AX = &H4F00                    'find subsequent file names
  79.   END IF
  80.  
  81.   Regs.CX = 39                          'any file attribute okay
  82.   Regs.DX = VARPTR(LocalSpec$)          'show DOS where the local copy is
  83.   CALL Interrupt(&H21, Regs, Regs)      'see if there's a match
  84.  
  85.   QBDir$ = ""                           'assume no matching file is present
  86.   IF (Regs.Flags AND 1) = 0 THEN        'if the Carry flag is clear, a
  87.     FileName$ = MID$(DTA, 31, 13)       '  file was found and its name
  88.     Zero = INSTR(FileName$, CHR$(0))    '  is in the DTA with a trailing
  89.     QBDir$ = LEFT$(FileName$, Zero - 1) '  CHR$(0) byte, strip the zero
  90.   END IF
  91.  
  92. END FUNCTION
  93.  
  94. FUNCTION SetAttr% (FileName$, Attribute) STATIC
  95.  
  96.   LocalSpec$ = FileName$ + CHR$(0)      'add a CHR$(0) for DOS
  97.  
  98.   Regs.AX = &H4301                      'set attribute sevice
  99.   Regs.CX = Attribute
  100.   Regs.DX = VARPTR(LocalSpec$)          'show DOS where the local copy is
  101.   CALL Interrupt(&H21, Regs, Regs)      'assign the new attributes
  102.  
  103.   SetAttr% = 0
  104.   IF Regs.Flags AND 1 THEN              'oops, there was an error
  105.     SetAttr% = -1                       'return -1 as a flag
  106.   END IF
  107.  
  108. END FUNCTION
  109.  
  110.